(1) HVFInfo()
# $ find . | grep "R$" | xargs grep -n "HVFInfo" --color=auto
# seurat-object-4.0.4/R/generics.R:364:HVFInfo <- function(object, selection.method, status = FALSE, ...) {
# seurat-object-4.0.4/R/seurat.R:1236:HVFInfo.Seurat <- function(
# seurat-object-4.0.4/R/assay.R:306:HVFInfo.Assay <- function(object, selection.method, status = FALSE, ...) {

#' Highly Variable Features
#'
#' Get and set variable feature information for an \code{\link{Assay}} object.
#' \code{HVFInfo} and \code{VariableFeatures} utilize generally variable
#' features, while \code{SVFInfo} and \code{SpatiallyVariableFeatures} are
#' restricted to spatially variable features
#'
#' @param object An object
#' @param selection.method Which method to pull. For \code{HVFInfo} and
#' \code{VariableFeatures}, choose one from one of the
#' following:
#' \itemize{
#'  \item \dQuote{vst}
#'  \item \dQuote{sctransform} or \dQuote{sct}
#'  \item \dQuote{mean.var.plot}, \dQuote{dispersion}, \dQuote{mvp}, or
#'   \dQuote{disp}
#' }
#' For \code{SVFInfo} and \code{SpatiallyVariableFeatures}, choose from:
#' \itemize{
#'  \item \dQuote{markvariogram}
#'  \item \dQuote{moransi}
#' }
#' @param status Add variable status to the resulting data frame
#'
#' @param ... Arguments passed to other methods
#'
#' @return \code{HVFInfo}: A data frame with feature means, dispersion, and
#' scaled dispersion
#'
#' @rdname VariableFeatures
#' @export HVFInfo
#'
#' @order 1
#'
#' @concept data-access
#'
HVFInfo <- function(object, selection.method, status = FALSE, ...) {
  UseMethod(generic = 'HVFInfo', object = object)
}

这是一个自定义S3函数。其中针对 Seurat 类的实现 HVFInfo.Seurat()

#' @param assay Name of assay to pull highly variable feature information for
#'
#' @importFrom tools file_path_sans_ext
#'
#' @rdname VariableFeatures
#' @export
#' @method HVFInfo Seurat
#'
#' @order 6
#'
#' @examples
#' # Get the HVF info from a specific Assay in a Seurat object
#' HVFInfo(object = pbmc_small, assay = "RNA")[1:5, ]
#'
HVFInfo.Seurat <- function(
  object,
  selection.method = NULL,
  status = FALSE,
  assay = NULL,
  ...
) {

  CheckDots(...) #检查参数

  object <- UpdateSlots(object = object) #刷新对象

  assay <- assay %||% DefaultAssay(object = object) #默认值是默认assay
  
  # 如果没有指定 selection.method
  if (is.null(x = selection.method)) {
    #(B1) 两种筛选变量的方法，组合上 .RNA 后缀。高变基因只可能在这里了。
    cmds <- apply(
      X = expand.grid(
        c('FindVariableFeatures', 'SCTransform'),
        FilterObjects(object = object, classes.keep = 'Assay')
      ),
      MARGIN = 1,
      FUN = paste,
      collapse = '.'
    )

    # (B2) 大集合在小集合中的元素，其实就是交集，并保持在大集合的顺序
    find.command <- Command(object = object)[Command(object = object) %in% cmds]
    # > Command(pbmc_small)
    # [1] "NormalizeData.RNA"        "ScaleData.RNA"           
    # [3] "RunPCA.RNA"               "BuildSNN.RNA.pca"        
    # [5] "FindClusters"             "RunTSNE.pca"             
    # [7] "JackStraw.RNA.pca"        "ScoreJackStraw.pca"      
    # [9] "ProjectDim.RNA.pca"       "FindVariableFeatures.RNA"

    # (B3) 如果长度是0，则报错：
    if (length(x = find.command) < 1) {
      stop(
        "Please run either 'FindVariableFeatures' or 'SCTransform'",
        call. = FALSE
      )
    }

    # (B4) 最后一条命令
    find.command <- find.command[length(x = find.command)]

    # (B5) 去掉后缀名，加上 . 和 assay名，命名为 test.comand
    test.command <- paste(file_path_sans_ext(x = find.command), assay, sep = '.')

    # (B6) 如果 test.comand 在 Comand(sce) 中，则取该值
    find.command <- ifelse(
      test = test.command %in% Command(object = object),
      yes = test.command,
      no = find.command
    )

    # (B7) 看去掉后缀后的命令等于啥，决定 选择方法的值。
    # 共2个选项，第3个报错
    selection.method <- switch(
      EXPR = file_path_sans_ext(x = find.command),
      'FindVariableFeatures' = Command(
        object = object,
        command = find.command,
        value = 'selection.method'
      ), #使用 pbmc_small是 'vst'
      'SCTransform' = 'sct',
      stop("Unknown command for finding variable features: '", find.command, "'", call. = FALSE)
    )

  }

  # 确定 方法后，又把决定权传给了 Assay类的方法
  return(HVFInfo(
    object = object[[assay]],
    selection.method = selection.method,
    status = status
  ))
}







# HVFInfo.Assay() 




#' @rdname VariableFeatures
#' @export
#' @method HVFInfo Assay
#'
#' @examples
#' # Get the HVF info directly from an Assay object
#' HVFInfo(pbmc_small[["RNA"]], selection.method = 'vst')[1:5, ]
#'
HVFInfo.Assay <- function(object, selection.method, status = FALSE, ...) {
  CheckDots(...) #检查参数

  # 离散度的方法
  disp.methods <- c('mean.var.plot', 'dispersion', 'disp')
  # 如果在，则统称为 mvp
  if (tolower(x = selection.method) %in% disp.methods) { #小写字母
    selection.method <- 'mvp'
  }
  
  # 如果小写字母后等于sctransform，则简写为 sct
  selection.method <- switch(
    EXPR = tolower(x = selection.method),
    'sctransform' = 'sct',
    selection.method
  )
  
  # 不同方法对应不同的列名，目前支持三个方法
  vars <- switch(
    EXPR = selection.method,
    'vst' = c('mean', 'variance', 'variance.standardized'),
    'mvp' = c('mean', 'dispersion', 'dispersion.scaled'),
    'sct' = c('gmean', 'variance', 'residual_variance'),
    stop("Unknown method: '", selection.method, "'", call. = FALSE)
  )

  # 获取数据，如果没有，则报错
  tryCatch(
    expr = hvf.info <- object[[paste(selection.method, vars, sep = '.')]],
    error = function(e) {
      stop(
        "Unable to find highly variable feature information for method '",
        selection.method,
        "'",
        call. = FALSE
      )
    }
  )
  # 加列名
  colnames(x = hvf.info) <- vars
  
  # 如果需要status，再获取是不是高变基因
  if (status) {
    hvf.info$variable <- object[[paste0(selection.method, '.variable')]]
  }

  return(hvf.info)
}


















(2) Loadings() 返回PCA的权重系数矩阵
> head(Loadings(pbmc_small), n=2)
             PC_1       PC_2        PC_3       PC_4        PC_5       PC_6
PPBP   0.33832535 0.04095778  0.02926261 0.03111034 -0.09042074 0.01318656
IGLL5 -0.03504289 0.05815335 -0.29906272 0.54744454  0.21460343 0.38357117

# $ find . | grep "R$" | xargs grep -n "Loadings" --color=auto
# seurat-object-4.0.4/R/generics.R:550:Loadings <- function(object, ...) {
# seurat-object-4.0.4/R/seurat.R:1388:Loadings.Seurat <- function(object, reduction = 'pca', projected = FALSE, ...) {
# seurat-object-4.0.4/R/dimreduc.R:326:Loadings.DimReduc <- function(object, projected = FALSE, ...)


#' Get and set feature loadings
#'
#' @param object An object
#' @param ... Arguments passed to other methods
#'
#' @return \code{Loadings}: the feature loadings for \code{object}
#'
#' @rdname Loadings
#' @export Loadings
#'
#' @concept data-access
#'
Loadings <- function(object, ...) {
  UseMethod(generic = 'Loadings', object = object)
}

是一个S3方法。


#' @param reduction Name of reduction to pull feature loadings for
#'
#' @rdname Loadings
#' @export
#' @method Loadings Seurat
#'
#' @examples
#' # Get the feature loadings for a specified DimReduc in a Seurat object
#' Loadings(object = pbmc_small, reduction = "pca")[1:5,1:5]
#'
Loadings.Seurat <- function(object, reduction = 'pca', projected = FALSE, ...) {
  object <- UpdateSlots(object = object)
  return(Loadings(object = object[[reduction]], projected = projected, ...))
}

直接抛给 降维 类了。


#' @param projected Pull the projected feature loadings?
#'
#' @rdname Loadings
#' @export
#' @method Loadings DimReduc
#'
#' @examples
#' # Get the feature loadings for a given DimReduc
#' Loadings(object = pbmc_small[["pca"]])[1:5,1:5]
#'
Loadings.DimReduc <- function(object, projected = FALSE, ...) {
  CheckDots(...) # 检查参数

  projected <- projected %||% Projected(object = object) #

  slot <- ifelse(
    test = projected,
    yes = 'feature.loadings.projected', #选择这个slot
    no = 'feature.loadings'
  )

  return(slot(object = object, name = slot))
}


内部方法：
> Seurat:::Projected(pbmc_small[['pca']])
[1] TRUE

所有的slot：
> slotNames(pbmc_small[["pca"]])
[1] "cell.embeddings"            "feature.loadings"           "feature.loadings.projected"
[4] "assay.used"                 "global"                     "stdev"                     
[7] "key"                        "jackstraw"                  "misc"














(3) "Idents<-"
# seurat-object-4.0.4/R/generics.R:409:"Idents<-" <- function(object, ..., value) {
# seurat-object-4.0.4/R/seurat.R:1305:"Idents<-.Seurat" <- function(object, cells = NULL, drop = FALSE, ..., value) {


#' @param value The name of the identities to pull from object metadata or the
#' identities themselves
#'
#' @return \code{Idents<-}: \code{object} with the cell identities changed
#'
#' @rdname Idents
#' @export Idents<-
#'
#' @examples
#' # Set cell identity classes
#' # Can be used to set identities for specific cells to a new level
#' Idents(pbmc_small, cells = 1:4) <- 'a'
#' head(Idents(pbmc_small))
#'
#' # Can also set idents from a value in object metadata
#' colnames(pbmc_small[[]])
#' Idents(pbmc_small) <- 'RNA_snn_res.1'
#' levels(pbmc_small)
#'
"Idents<-" <- function(object, ..., value) {
  UseMethod(generic = 'Idents<-', object = object)
}



#' @param cells Set cell identities for specific cells #设置 Idents 值
#' @param drop Drop unused levels #是否去掉不用的level，默认是保留。
#'
#' @rdname Idents
#' @export
#' @method Idents<- Seurat
#'
# Idents(sce)=valueXX; #右侧的值是value。
"Idents<-.Seurat" <- function(object, cells = NULL, drop = FALSE, ..., value) {
  CheckDots(...) #检查参数 ...

  object <- UpdateSlots(object = object) #更新对象

  # (A1) cells 默认值为所有cells
  cells <- cells %||% colnames(x = object)
  # 数字的话，转为 cell id
  if (is.numeric(x = cells)) {
    cells <- colnames(x = object)[cells]
  }
  # 求交集 
  cells <- intersect(x = cells, y = colnames(x = object))
  # 交集结果，在全部细胞中的下标
  cells <- match(x = cells, table = colnames(x = object))
  # > match(c(-1,10,3,7), 1:10)
  # [1] NA 10  3  7

  # 如果长度为0，则警告，返回对象本身。
  if (length(x = cells) == 0) {
    warning("Cannot find cells provided")
    return(object)
  }


  # (A2) 给 idents 赋值。
  # 如果 等号右侧的中是一个，且在 meta.data的列名中，
  idents.new <- if (length(x = value) == 1 && value %in% colnames(x = object[[]])) {
    # 展开该列，按cells下标取子集
    unlist(x = object[[value]], use.names = FALSE)[cells]
  # 如果 等号右侧是多个值
  } else {
    # 如果是list，解开list，不要name
    if (is.list(x = value)) {
      value <- unlist(x = value, use.names = FALSE)
    }
    # 重复这些值，长度和细胞长度相同。
    rep_len(x = value, length.out = length(x = cells))
    # > rep_len(x = c("A", "B"), length.out = 10)
    # [1] "A" "B" "A" "B" "A" "B" "A" "B" "A" "B"
  }

  
  # (A3) 获取新 idents 的各个水平
  # 如果是因子，获取 levels，否则 unique()
  new.levels <- if (is.factor(x = idents.new)) {
    levels(x = idents.new)
  } else {
    unique(x = idents.new)
  }

  # (A4) 获取旧的水平
  old.levels <- levels(x = object)
  # (A5) 新旧水平合并为向量 ??? 干啥用的？ 后面说
  levels <- c(new.levels, old.levels)



  # (A6) 新 idents 转为向量
  idents.new <- as.vector(x = idents.new)
  # (A7) 老的Idents 由 named因子 转为 向量（失去cell id）
  idents <- as.vector(x = Idents(object = object)) #返回的是 sce@active.ident
  # (A8) 老的idents 的这些cells 赋值为新 idents
  idents[cells] <- idents.new
  # (A9) 其中的NA命名为字符串 "NA"
  idents[is.na(x = idents)] <- 'NA'


  # (A10) 求交集：新旧水平 与 现有idents 的uniq值
  levels <- intersect(x = levels, y = unique(x = idents))
  # (A11) 给 idents 命名: sce的列名(cell id)
  names(x = idents) <- colnames(x = object)
  # 查名字，也就是cell id 为na值的位置下标
  missing.cells <- which(x = is.na(x = names(x = idents)))

  # 如果有na值，则去掉  --> 什么情况下会有NA？最前面cells已经取交集了，
  if (length(x = missing.cells) > 0) {
    idents <- idents[-missing.cells]
  }
  
  # 变因子
  idents <- factor(x = idents, levels = levels)
  
  # 为 sce@active.ident 赋值
  slot(object = object, name = 'active.ident') <- idents

  # 如果要去掉不用的水平
  if (drop) {
    object <- droplevels(x = object)
  }
  
  return(object)
}





# $ find . | grep "R$" | xargs grep -n "droplevels" --color=auto
# seurat-object-4.0.4/R/seurat.R:2211:droplevels.Seurat <- function(x, ...) {

#' @rdname Idents
#' @export
#' @method droplevels Seurat
#'
droplevels.Seurat <- function(x, ...) {
  x <- UpdateSlots(object = x)
  slot(object = x, name = 'active.ident') <- droplevels(x = Idents(object = x), ...)
  return(x)
}
